Thema Datum  Von Nutzer Rating
Antwort
15.12.2020 10:21:05 Rene
NotSolved
Blau Wert in Spalte suchen -> kopieren und auf ein anderes Blatt übertragen
15.12.2020 10:40:08 volti
NotSolved
15.12.2020 11:01:32 Rene
NotSolved
15.12.2020 11:01:32 Rene
NotSolved
15.12.2020 11:38:21 volti
Solved
15.12.2020 13:11:46 Rene
NotSolved
15.12.2020 13:12:17 Rene
NotSolved
15.12.2020 13:12:17 Rene
NotSolved
15.12.2020 13:12:18 Rene
NotSolved

Ansicht des Beitrags:
Von:
volti
Datum:
15.12.2020 10:40:08
Views:
660
Rating: Antwort:
  Ja
Thema:
Wert in Spalte suchen -> kopieren und auf ein anderes Blatt übertragen

Hallo Rene,

da passiert deshalb nichts, weil 12 nicht die Nummer für die Spalte "Q" ist und weil "BaumHaus" nicht  "Baum, Haus"entspricht.

Dann stellt sich die Frage: Sind die technischen Blattnamen Tabelle1 und Tabelle2 auch die richtigen oder solltest Du lieber die Registernamen nehmen.

Hier mal zwei Varianten als Idee:

Code:
 
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
 
Option Explicit
Option Compare Text

Sub BedingteKopieZeilen1()
  
  Dim Zeile    As Long
  Dim ZeileOut As Long
  
  With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
  End With
  
  With Sheets("Tabelle1")
     ZeileOut = 1
     For Zeile = 2 To .Cells(Rows.Count, "Q").End(xlUp).Row
        If .Cells(Zeile, "Q").Value Like "Haus*BaumThen
           .Rows(Zeile).Copy Destination:=Sheets("Tabelle2").Rows(ZeileOut)
           ZeileOut = ZeileOut + 1
        End If
     Next Zeile
  End With
  
  With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
  End With
  
End Sub

Sub BedingteKopieZeilen2()
  
  Dim Zeile    As Long
  Dim ZeileOut As Long
  
  With Application
     .ScreenUpdating = False
     .EnableEvents = False
     .Calculation = xlCalculationManual
  End With
  
  With Tabelle1
     ZeileOut = 1
     For Zeile = 2 To .Cells(Rows.Count, "Q").End(xlUp).Row
        If .Cells(Zeile, "Q").Value Like "Haus*BaumThen
           .Rows(Zeile).Copy Destination:=Tabelle2.Rows(ZeileOut)
           ZeileOut = ZeileOut + 1
        End If
     Next Zeile
  End With
  
  With Application
     .ScreenUpdating = True
     .EnableEvents = True
     .Calculation = xlCalculationAutomatic
  End With
  
End Sub
 
_________
viele Grüße
Karl-Heinz

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen